home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 1999 July / APC47-2.ISO / mac / macsbug / macsbug.hqx / MacsBug 6.5.4a6 / Building dcmds / Pascal Samples / Heap.p < prev    next >
Encoding:
Text File  |  1998-09-22  |  3.0 KB  |  115 lines
  1. {
  2.     File:        Heap.p
  3.  
  4.     Contains:    A sample dcmd which dumps heap blocks.
  5.  
  6.     Written by:    JM3 = Jim Murphy
  7.  
  8.     Copyright:    ⌐ 1994 by Apple Computer, Inc., All Rights Reserved.
  9.  
  10.     Change History (most recent first):
  11.  
  12.          <2>   14-Dec-94    JM3        Updated for new version 3 dcmd requirements.
  13.  
  14. }
  15.  
  16. UNIT Heap;
  17.  
  18. (* The following MPW commands will build the dcmd and copy it to the
  19.    "Debugger Prefs" file in the System folder. The dcmd's name in
  20.          MacsBug will be the name of the file built by the Linker.
  21.  
  22.         Pascal Heap.p
  23.         Link dcmdGlue.a.o Heap.p.o "{Libraries}Runtime.o" "{PLibraries}PasLib.o" -o Heap
  24.         BuildDcmd Heap 100
  25.                     Echo 'include "Heap";'            |            Rez -a -o "{systemFolder}Debugger Prefs"
  26. *)
  27.  
  28. {$R-}
  29.  
  30. INTERFACE
  31.  
  32.         USES MemTypes, dcmd;
  33.         
  34.   { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
  35.         PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);
  36.  
  37.  
  38. IMPLEMENTATION
  39.  
  40. PROCEDURE NumberToHex (number: LONGINT; VAR hex: Str255);
  41. VAR    digits: Str255;
  42.     n: INTEGER;
  43. BEGIN
  44.     digits := '0123456789ABCDEF';
  45.     hex    := '00000000';
  46.     FOR n := 8 DOWNTO 1 DO
  47.     BEGIN
  48.         hex[n] := digits[1 + (number MOD 16)];
  49.         number := number DIV 16;
  50.     END;
  51. END;
  52.  
  53.  
  54. PROCEDURE DisplayBlockInfo (blockAddress, blockLength, masterPtr: LONGINT; blockType: INTEGER; locked, purgeable, resource: BOOLEAN);
  55. VAR value: Str255;
  56. BEGIN
  57.     NumberToHex (blockAddress, value);
  58.     dcmdDrawLine (value);
  59.  
  60.     NumberToHex (blockLength, value);
  61.     dcmdDrawString (' ');
  62.     dcmdDrawString (value);
  63.  
  64.     IF blockType = relocatableBlock THEN
  65.     BEGIN
  66.         NumberToHex (masterPtr, value);
  67.         dcmdDrawString (' ');
  68.         dcmdDrawString (value);
  69.     
  70.         dcmdDrawString (' ');
  71.         IF locked THEN
  72.             dcmdDrawString ('Locked ');
  73.         IF purgeable THEN
  74.             dcmdDrawString ('Purgeable ');
  75.         IF resource THEN
  76.             dcmdDrawString ('Resource ');
  77.     END;
  78. END;
  79.  
  80.  
  81. PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
  82. BEGIN
  83.     IF paramPtr^.request = dcmdInit THEN
  84.     BEGIN    { The dcmd gets called once when loaded to init itself }
  85.     END
  86.     ELSE IF paramPtr^.request = dcmdDoIt THEN
  87.     BEGIN    { Do the command's normal function }
  88.             { Draw the column labels }
  89.         dcmdDrawLine ('  Address   Length  Mstr Ptr');
  90.  
  91.         { The MacsBug heap iterator will call DisplayBlockInfo once for each block in the heap }
  92.         dcmdForAllHeapBlocks (@DisplayBlockInfo);
  93.     END
  94.     ELSE IF paramPtr^.request = dcmdHelp THEN { Display the command's help information }
  95.     BEGIN
  96.         dcmdDrawLine ('Displays information about all heap blocks.');
  97.     END
  98.     ELSE IF paramPtr^.request = dcmdGetInfo THEN
  99.     BEGIN { Display the command's help information }
  100.  
  101.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.usageStr := '';
  102.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.creditsStr := '';
  103.  
  104.         { Set the version to 3.0 final. }
  105.  
  106.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.majorRev := $03;
  107.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.minorAndBugRev := $00;
  108.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.stage := $80;
  109.         GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.nonRelRev := $00;        
  110.     END;
  111.  
  112. END;
  113.  
  114. END.
  115.